home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / prog_pas / ddplus63.zip / BBSLIST.PAS < prev    next >
Pascal/Delphi Source File  |  1991-09-20  |  20KB  |  737 lines
  1. {-------------------------------------------------------------------------}
  2. {                                                                         }
  3. { Program: BBS-LIST                                                       }
  4. {                                                                         }
  5. { Purpose: Maintains a bbs list database. Demonstrates use of ANSIMENU    }
  6. {          unit.                                                          }
  7. {                                                                         }
  8. {-------------------------------------------------------------------------}
  9.  
  10.  
  11. {$V-}
  12. {$M 32768,0,256000}
  13. uses dos, crt, doordriv,ddscott,ansimenu;
  14.  
  15. const
  16.  comps: array[1..10] of string[20]=
  17.         ('IBM',      'Amiga',        'Apple',         'Atari',
  18.          'C-64',     'Mac',          'Coco',          'other',
  19.          'other',    'other');
  20.  compbig: array[1..10] of string[30]=
  21.         ('IBM & Compatibles',        'Commodore Amiga',
  22.          'Apple',                    'Atari',
  23.          'Commodore C-64',           'Tandy Color Computer',
  24.          'Other',                    'Other',
  25.          'Other',                    'Other');
  26.  menu1: menutype =
  27.          (header: 'BBS-List Maintenance System';
  28.           footer: 'Please type a command letter';
  29.           headercolor: green;
  30.           footercolor: lightgreen;
  31.           optioncolor: yellow;
  32.           desccolor: white;
  33.           arrowcolor: lightred;
  34.           bracketcolor: lightgray;
  35.           numoptions: 10;
  36.           options: ('A','B','C','D','E','F','G','H','I','Q','','','','','',
  37.                     '','','','','');
  38.           desc: ('Enter a New Listing',          'Edit an existing listing',
  39.                  'Display 80-col GRPX',          'Display 80-col ASCII',
  40.                  'Display 132-col GRPX',         'Display 132-col ASCII',
  41.                  'Write lists to disk',          'Sort Listing',
  42.                  'Statistics',                   'Quit to bbs',
  43.                  '',                             '',
  44.                  '','','','','','','',''));
  45. type
  46.  bbsentry= record
  47.             active: boolean;
  48.             board_name: string[20];
  49.             number: string[8];
  50.             hours: string[10];
  51.             max_baud: word;
  52.             allow3: boolean;
  53.             megs: word;
  54.             network: string[10];
  55.             sysop_name: string[20];
  56.             software: string[10];
  57.             pay: boolean;
  58.             computers: array[1..10] of byte;
  59.             comments: array[1..5] of string[80];
  60.            end;
  61. var
  62.  bbsfile: file of bbsentry;
  63.  bbs: bbsentry;
  64.  f: text;
  65.  todisk: boolean;
  66.  sortmode: integer;
  67.  
  68. procedure add_system;
  69. var
  70.  s: string;
  71.  a: integer;
  72. begin;
  73.  sclrscr;
  74.  set_foreground(green);
  75.  swriteln('Add a bbs to the list');
  76.  swriteln('');
  77.  set_foreground(default_fore);
  78.  bbs.active:=true;
  79.  swrite('         Board Name: '); prompt(bbs.board_name,20,true);
  80.  swrite('       Phone number: '); prompt(bbs.number,8,true);
  81.  swrite('              Hours: '); prompt(bbs.hours,10,true);
  82.  swrite('           Max baud: '); prompt(s,4,true); val(s,bbs.max_baud,a);
  83.  swrite('  300 allowed (Y/N): '); prompt(s,1,true); if (s='Y') or (s='y') then bbs.allow3:=true else bbs.allow3:=false;
  84.  swrite('  Megabytes storage: '); prompt(s,4,true); val(s,bbs.megs,a);
  85.  swrite('    Network address: '); prompt(bbs.network,10,true);
  86.  swrite('         Sysop name: '); prompt(bbs.sysop_name,20,true);
  87.  swrite('           Software: '); prompt(bbs.software,10,true);
  88.  swrite(' Pay required (Y/N): '); prompt(s,1,true); if (s='Y') or (s='y') then bbs.pay:=true else bbs.pay:=false;
  89.  for a:=1 to 7 do begin;
  90.   s:=comps[a];
  91.   while length(s)<11 do s:=' '+s;
  92.   swrite(s+' (Y/N/M):');
  93.   prompt(s,1,true);
  94.   if (s='Y') or (s='y') then bbs.computers[a]:=1 else bbs.computers[a]:=0;
  95.   if (s='M') or (s='m') then bbs.computers[a]:=2;
  96.  end;
  97.  swriteln('');
  98.  swriteln('Comments: 5 lines max');
  99.  for a:=1 to 5 do begin;
  100.   swrite(va(a)+':'); prompt(bbs.comments[a],75,true);
  101.  end;
  102.  swriteln('');
  103.  swrite('Add this entry ? '); sread(s);
  104.  if (s='Y') or (s='y') then begin;
  105.   seek(bbsfile,filesize(bbsfile));
  106.   write(bbsfile,bbs);
  107.  end;
  108. end;
  109.  
  110. procedure textout(s: string);
  111. begin;
  112.  if todisk then writeln(f,s) else swriteln(s);
  113. end;
  114.  
  115. procedure copystring(src: string; var dest: string; num: integer);
  116. var
  117.  a: integer;
  118. begin;
  119.  for a:=1 to num do dest:=dest+src;
  120. end;
  121.  
  122. procedure display_80_asc_old;
  123. var
  124.  a: integer;
  125.  s,s2: string;
  126. begin;
  127.  textout('                               ┌─────┬─┬─┬─┬─┬─┬─┬─┬──────┬─┬─┐');
  128.  textout('                               │     │I│A│A│A│C│M│C│      │3│$│');
  129.  textout('                               │  M  │B│m│p│t│o│a│o│ B R  │0│P│');
  130.  textout('                               │  E  │M│i│p│a│m│c│C│ A A  │0│A│');
  131.  textout('                               │  G  │ │g│l│r│m│ │o│ U T  │ │Y│');
  132.  textout('                               │  S  │ │a│e│i│ │ │ │ D E  │ │$│');
  133.  textout('  System Name          Phone # │     │ │ │ │ │ │ │ │      │ │ │  Hours');
  134.  s:='';
  135.  copystring('─',s,31);
  136.  s:=s+'┼';
  137.  copystring('─',s,5);
  138.  s:=s+'┼─┼─┼─┼─┼─┼─┼─┼─────┼─┼─┼';
  139.  copystring('─',s,9);
  140.  s:=s+'┐';
  141.  textout(s);
  142.  reset(bbsfile);
  143.  while not eof(bbsfile) do begin;
  144.   read(bbsfile,bbs);
  145.   s:='  '+bbs.board_name;
  146.   while length(s)<23 do s:=s+' ';
  147.   s:=s+bbs.number;
  148.   while length(s)<31 do s:=s+' ';
  149.   s:=s+'│ ';
  150.   s2:=va(bbs.megs);
  151.   while length(s2)<3 do s2:=' '+s2;
  152.   s:=s+s2+' │';
  153.   for a:=1 to 7 do begin;
  154.    if bbs.computers[a]=1 then s:=s+'■│';
  155.    if bbs.computers[a]=0 then s:=s+' │';
  156.    if bbs.computers[a]=2 then s:=s+'▓│';
  157.   end;
  158.   str(bbs.max_baud,s2);
  159.   while length(s2)<4 do s2:=' '+s2;
  160.   s:=s+s2+' │';
  161.   if bbs.allow3 then s:=s+'■' else s:=s+' ';
  162.   s:=s+'│';
  163.   if bbs.pay then s:=s+'■' else s:=s+' ';
  164.   s:=s+'│';
  165.   s2:=bbs.hours;
  166.   while length(s2)<9 do s2:=s2+' ';
  167.   s:=s+s2+'│';
  168.   textout(s);
  169.  end;
  170. end;
  171.  
  172. procedure display_80_asc;
  173. var
  174.  a: integer;
  175.  s,s2: string;
  176. begin;
  177.  textout('                                       ┌─┬─┬─┬─┬─┬─┬─┬─┬─┐');
  178.  textout('                                       │I│A│A│A│C│M│C│N│$│');
  179.  textout('                                       │B│m│p│t│o│a│o│O│P│');
  180.  textout('                                       │M│i│p│a│m│c│C│3│A│');
  181.  textout('                                       │ │g│l│r│m│ │o│0│Y│');
  182.  textout('                                       │ │a│e│i│ │ │ │0│$│');
  183.  textout('  System Name          Phone #    Megs │ │ │ │ │ │ │ │ │ │ Baud   Hours');
  184.  s:='┌';
  185.  copystring('─',s,31);
  186.  s:=s+'┬';
  187.  copystring('─',s,6);
  188.  s:=s+'┼─┼─┼─┼─┼─┼─┼─┼─┼─┼';
  189.  copystring('─',s,6);
  190.  s:=s+'┬';
  191.  copystring('─',s,10);
  192.  s:=s+'┐';
  193.  textout(s);
  194.  reset(bbsfile);
  195.  while not eof(bbsfile) do begin;
  196.   read(bbsfile,bbs);
  197.   s:='│ '+bbs.board_name;
  198.   while length(s)<23 do s:=s+' ';
  199.   s:=s+bbs.number;
  200.   while length(s)<32 do s:=s+' ';
  201.   s:=s+'│ ';
  202.   s2:=va(bbs.megs);
  203.   while length(s2)<4 do s2:=' '+s2;
  204.   s:=s+s2+' │';
  205.   for a:=1 to 7 do begin;
  206.    if bbs.computers[a]=1 then s:=s+'■│';
  207.    if bbs.computers[a]=0 then s:=s+' │';
  208.    if bbs.computers[a]=2 then s:=s+'▓│';
  209.   end;
  210.   if not bbs.allow3 then s:=s+'■' else s:=s+' ';
  211.   s:=s+'│';
  212.   if bbs.pay then s:=s+'■' else s:=s+' ';
  213.   s:=s+'│';
  214.   str(bbs.max_baud,s2);
  215.   while length(s2)<5 do s2:=' '+s2;
  216.   s:=s+s2+' │ ';
  217.   s2:=bbs.hours;
  218.   while length(s2)<9 do s2:=s2+' ';
  219.   s:=s+s2+'│';
  220.   textout(s);
  221.  end;
  222.  s:='└';
  223.  copystring('─',s,31);
  224.  s:=s+'┴';
  225.  copystring('─',s,6);
  226.  s:=s+'┴─┴─┴─┴─┴─┴─┴─┴─┴─┴';
  227.  copystring('─',s,6);
  228.  s:=s+'┴';
  229.  copystring('─',s,10);
  230.  s:=s+'┘';
  231.  textout(s);
  232. end;
  233.  
  234. procedure display_132_asc;
  235. var
  236.  a: integer;
  237.  s,s2: string;
  238. begin;
  239.  textout('                                       ┌─┬─┬─┬─┬─┬─┬─┬─┬─┐');
  240.  textout('                                       │I│A│A│A│C│M│C│N│$│');
  241.  textout('                                       │B│m│p│t│o│a│o│O│P│');
  242.  textout('                                       │M│i│p│a│m│c│C│3│A│');
  243.  textout('                                       │ │g│l│r│m│ │o│0│Y│');
  244.  textout('                                       │ │a│e│i│ │ │ │0│$│');
  245.  textout('  System Name          Phone #    Megs │ │ │ │ │ │ │ │ │ │ Baud   Hours      Software        Sysop'+
  246.          '                Network');
  247.  s:='┌';
  248.  copystring('─',s,31);
  249.  s:=s+'┬';
  250.  copystring('─',s,6);
  251.  s:=s+'┼─┼─┼─┼─┼─┼─┼─┼─┼─┼';
  252.  copystring('─',s,6);
  253.  s:=s+'┬';
  254.  copystring('─',s,10);
  255.  s:=s+'┬';
  256.  copystring('─',s,15);
  257.  s:=s+'┬';
  258.  copystring('─',s,20);
  259.  s:=s+'┬';
  260.  copystring('─',s,10);
  261.  s:=s+'┐';
  262.  textout(s);
  263.  reset(bbsfile);
  264.  while not eof(bbsfile) do begin;
  265.   read(bbsfile,bbs);
  266.   s:='│ '+bbs.board_name;
  267.   while length(s)<23 do s:=s+' ';
  268.   s:=s+bbs.number;
  269.   while length(s)<32 do s:=s+' ';
  270.   s:=s+'│ ';
  271.   s2:=va(bbs.megs);
  272.   while length(s2)<4 do s2:=' '+s2;
  273.   s:=s+s2+' │';
  274.   for a:=1 to 7 do begin;
  275.    if bbs.computers[a]=1 then s:=s+'■│';
  276.    if bbs.computers[a]=0 then s:=s+' │';
  277.    if bbs.computers[a]=2 then s:=s+'▓│';
  278.   end;
  279.   if not bbs.allow3 then s:=s+'■' else s:=s+' ';
  280.   s:=s+'│';
  281.   if bbs.pay then s:=s+'■' else s:=s+' ';
  282.   s:=s+'│';
  283.   str(bbs.max_baud,s2);
  284.   while length(s2)<5 do s2:=' '+s2;
  285.   s:=s+s2+' │ ';
  286.   s2:=bbs.hours;
  287.   while length(s2)<9 do s2:=s2+' ';
  288.   s:=s+s2+'│';
  289.   s2:=' '+bbs.software;
  290.   while length(s2)<15 do s2:=s2+' ';
  291.   s:=s+s2+'│';
  292.   s2:=' '+bbs.sysop_name;
  293.   while length(s2)<20 do s2:=s2+' ';
  294.   s:=s+s2+'│';
  295.   s2:=' '+bbs.network;
  296.   while length(s2)<10 do s2:=s2+' ';
  297.   s:=s+s2+'│';
  298.   textout(s);
  299.  end;
  300.  s:='└';
  301.  copystring('─',s,31);
  302.  s:=s+'┴';
  303.  copystring('─',s,6);
  304.  s:=s+'┴─┴─┴─┴─┴─┴─┴─┴─┴─┴';
  305.  copystring('─',s,6);
  306.  s:=s+'┴';
  307.  copystring('─',s,10);
  308.  s:=s+'┴';
  309.  copystring('─',s,15);
  310.  s:=s+'┴';
  311.  copystring('─',s,20);
  312.  s:=s+'┴';
  313.  copystring('─',s,10);
  314.  s:=s+'┘';
  315.  textout(s);
  316. end;
  317.  
  318. procedure display_80_txt;
  319. var
  320.  a: integer;
  321.  s,s2: string;
  322. begin;
  323.  textout('                                       +-----------------+');
  324.  textout('                                       :I:A:A:A:C:M:C:N:$:');
  325.  textout('                                       :B:m:p:t:o:a:o:O:P:');
  326.  textout('                                       :M:i:p:a:m:c:C:3:A:');
  327.  textout('                                       : :g:l:r:m: :o:0:Y:');
  328.  textout('                                       : :a:e:i: : : :0:$:');
  329.  textout('  System Name          Phone #    Megs : : : : : : : : : : Baud   Hours');
  330.  s:='';
  331.  copystring('-',s,32);
  332.  s:=s+'+';
  333.  copystring('-',s,6);
  334.  s:=s+'+-+-+-+-+-+-+-+-+-+';
  335.  copystring('-',s,6);
  336.  s:=s+'+';
  337.  copystring('-',s,10);
  338.  {s:=s+'┐';}
  339.  textout(s);
  340.  reset(bbsfile);
  341.  while not eof(bbsfile) do begin;
  342.   read(bbsfile,bbs);
  343.   s:='  '+bbs.board_name;
  344.   while length(s)<23 do s:=s+' ';
  345.   s:=s+bbs.number;
  346.   while length(s)<32 do s:=s+' ';
  347.   s:=s+': ';
  348.   s2:=va(bbs.megs);
  349.   while length(s2)<4 do s2:=' '+s2;
  350.   s:=s+s2+' :';
  351.   for a:=1 to 7 do begin;
  352.    if bbs.computers[a]=1 then s:=s+'*:';
  353.    if bbs.computers[a]=0 then s:=s+' :';
  354.    if bbs.computers[a]=2 then s:=s+'X:';
  355.   end;
  356.   if not bbs.allow3 then s:=s+'*' else s:=s+' ';
  357.   s:=s+':';
  358.   if bbs.pay then s:=s+'*' else s:=s+' ';
  359.   s:=s+':';
  360.   str(bbs.max_baud,s2);
  361.   while length(s2)<5 do s2:=' '+s2;
  362.   s:=s+s2+' : ';
  363.   s2:=bbs.hours;
  364.   while length(s2)<9 do s2:=s2+' ';
  365.   s:=s+s2 {+'│'};
  366.   textout(s);
  367.  end;
  368.  s:='';
  369.  copystring('-',s,32);
  370.  s:=s+'+';
  371.  copystring('-',s,6);
  372.  s:=s+'+-+-+-+-+-+-+-+-+-+';
  373.  copystring('-',s,6);
  374.  s:=s+'+';
  375.  copystring('-',s,10);
  376.  textout(s);
  377. end;
  378.  
  379. procedure display_132_txt;
  380. var
  381.  a: integer;
  382.  s,s2: string;
  383. begin;
  384.  textout('                                       +-----------------+');
  385.  textout('                                       :I:A:A:A:C:M:C:N:$:');
  386.  textout('                                       :B:m:p:t:o:a:o:O:P:');
  387.  textout('                                       :M:i:p:a:m:c:C:3:A:');
  388.  textout('                                       : :g:l:r:m: :o:0:Y:');
  389.  textout('                                       : :a:e:i: : : :0:$:');
  390.  textout('  System Name          Phone #    Megs : : : : : : : : : : Baud   Hours      Software        Sysop'+
  391.          '                Network');
  392.  s:='+';
  393.  copystring('-',s,31);
  394.  s:=s+'+';
  395.  copystring('-',s,6);
  396.  s:=s+'+-+-+-+-+-+-+-+-+-+';
  397.  copystring('-',s,6);
  398.  s:=s+'+';
  399.  copystring('-',s,10);
  400.  s:=s+'+';
  401.  copystring('-',s,15);
  402.  s:=s+'+';
  403.  copystring('-',s,20);
  404.  s:=s+'+';
  405.  copystring('-',s,10);
  406.  s:=s+'+';
  407.  textout(s);
  408.  reset(bbsfile);
  409.  while not eof(bbsfile) do begin;
  410.   read(bbsfile,bbs);
  411.   s:=': '+bbs.board_name;
  412.   while length(s)<23 do s:=s+' ';
  413.   s:=s+bbs.number;
  414.   while length(s)<32 do s:=s+' ';
  415.   s:=s+': ';
  416.   s2:=va(bbs.megs);
  417.   while length(s2)<4 do s2:=' '+s2;
  418.   s:=s+s2+' :';
  419.   for a:=1 to 7 do begin;
  420.    if bbs.computers[a]=1 then s:=s+'*:';
  421.    if bbs.computers[a]=0 then s:=s+' :';
  422.    if bbs.computers[a]=2 then s:=s+'X:';
  423.   end;
  424.   if not bbs.allow3 then s:=s+'*' else s:=s+' ';
  425.   s:=s+':';
  426.   if bbs.pay then s:=s+'*' else s:=s+' ';
  427.   s:=s+':';
  428.   str(bbs.max_baud,s2);
  429.   while length(s2)<5 do s2:=' '+s2;
  430.   s:=s+s2+' : ';
  431.   s2:=bbs.hours;
  432.   while length(s2)<9 do s2:=s2+' ';
  433.   s:=s+s2+':';
  434.   s2:=' '+bbs.software;
  435.   while length(s2)<15 do s2:=s2+' ';
  436.   s:=s+s2+':';
  437.   s2:=' '+bbs.sysop_name;
  438.   while length(s2)<20 do s2:=s2+' ';
  439.   s:=s+s2+':';
  440.   s2:=' '+bbs.network;
  441.   while length(s2)<10 do s2:=s2+' ';
  442.   s:=s+s2+':';
  443.   textout(s);
  444.  end;
  445.  s:='+';
  446.  copystring('-',s,31);
  447.  s:=s+'+';
  448.  copystring('-',s,6);
  449.  s:=s+'+-+-+-+-+-+-+-+-+-+';
  450.  copystring('-',s,6);
  451.  s:=s+'+';
  452.  copystring('-',s,10);
  453.  s:=s+'+';
  454.  copystring('-',s,15);
  455.  s:=s+'+';
  456.  copystring('-',s,20);
  457.  s:=s+'+';
  458.  copystring('-',s,10);
  459.  s:=s+'+';
  460.  textout(s);
  461. end;
  462.  
  463. procedure DisplayStats;
  464. var
  465.  cstats: array[1..10] of byte;
  466.  a,b: integer;
  467.  numsystems: integer;
  468.  s,s2,s3: string;
  469. begin;
  470.  numsystems:=0;
  471.  for b:=1 to 10 do cstats[b]:=0;
  472.  for a:=1 to filesize(bbsfile)-1 do begin;
  473.   seek(bbsfile,a);
  474.   read(bbsfile,bbs);
  475.   for b:=1 to 10 do if bbs.computers[b]=2 then inc(cstats[b]);
  476.   inc(numsystems);
  477.  end;
  478.  textout('System Statisics: ');
  479.  textout('');
  480.  s3:='';
  481.  for a:=1 to 7 do begin;
  482.   if length(s3)>40 then begin;
  483.    textout(s3);
  484.    s3:='';
  485.   end;
  486.   s:=compbig[a];
  487.   while length(s)<25 do s:=s+'.';
  488.   s2:=va(cstats[a]);
  489.   while length(s2)<2 do s2:=s2+' ';
  490.   s:=s+' '+s2+', ';
  491.   str(round(cstats[a]/numsystems*100),s2);
  492.   s:=s+s2+'%';
  493.   s3:=s3+s;
  494.   while length(s3)<40 do s3:=s3+' ';
  495.  end;
  496.  if length(s)<40 then textout(s);
  497. end;
  498.  
  499. procedure write_to_disk;
  500. begin;
  501.  assign(f,'BBS80.ASC');
  502.  rewrite(f);
  503.  todisk:=true;
  504.  display_80_asc;
  505.  close(f);
  506.  assign(f,'BBS132.ASC');
  507.  rewrite(f);
  508.  display_132_asc;
  509.  close(f);
  510.  assign(f,'BBS80.TXT');
  511.  rewrite(f);
  512.  display_80_txt;
  513.  close(f);
  514.  assign(f,'BBS132.TXT');
  515.  rewrite(f);
  516.  display_132_txt;
  517.  close(f);
  518.  assign(f,'STATS.TXT');
  519.  rewrite(f);
  520.  displaystats;
  521.  close(f);
  522.  todisk:=false;
  523. end;
  524.  
  525. procedure display_thing(s,s2: string);
  526. begin;
  527.  set_foreground(green);
  528.  swrite(s);
  529.  set_foreground(white);
  530.  swriteln(s2);
  531.  set_foreground(default_fore);
  532. end;
  533.  
  534. function yn(b: boolean): string;
  535. begin;
  536.  if b then yn:='Yes' else yn:='No';
  537. end;
  538.  
  539. procedure display_rec;
  540. var
  541.  a: integer;
  542. begin;
  543.  display_thing('A. Board Name.......... ',bbs.board_name);
  544.  display_thing('B. Phone number........ ',bbs.number);
  545.  display_thing('C. Hours............... ',bbs.hours);
  546.  display_thing('D. Max baud............ ',va(bbs.max_baud));
  547.  display_thing('E. 300 allowed (Y/N)... ',yn(bbs.allow3));
  548.  display_thing('F. Megabytes storage... ',va(bbs.megs));
  549.  display_thing('G. Network address..... ',bbs.network);
  550.  display_thing('H. Sysop name.......... ',bbs.sysop_name);
  551.  display_thing('I. Software............ ',bbs.software);
  552.  display_thing('J. Pay required (Y/N).. ',yn(bbs.pay));
  553.  display_thing('K. Systems............. ','');
  554.  set_foreground(lightcyan);
  555.  swriteln('L. Comments:');
  556.  set_foreground(white);
  557.  for a:=1 to 5 do if bbs.comments[a]<>'' then swriteln(bbs.comments[a]);
  558.  set_foreground(default_fore);
  559. end;
  560.  
  561. procedure edit_systems;
  562. const
  563.  comptype: array[0..2] of string[10]=
  564.             ('No','Yes','Main');
  565. var
  566.  s: string;
  567.  ctype: string;
  568.  a,b: integer;
  569. begin;
  570.  repeat;
  571.   sclrscr;
  572.   for a:=1 to 7 do begin;
  573.    ctype:=comps[a];
  574.    while length(ctype)<15 do ctype:=ctype+'.';
  575.    display_thing(va(a)+'. '+ctype,comptype[bbs.computers[a]]);
  576.   end;
  577.   swriteln('');
  578.   swrite('Enter option to change, or <9> to quit ? '); sread_num(a);
  579.   if (a>0) and (a<8) then begin;
  580.    swrite(comps[a]+' (Y/N/M) ? '); prompt(s,1,true); s:=stu(s);
  581.    if s='Y' then bbs.computers[a]:=1;
  582.    if s='N' then bbs.computers[a]:=0;
  583.    if s='M' then bbs.computers[a]:=2;
  584.   end;
  585.  until a=9;
  586. end;
  587.  
  588. procedure edit_bbslist;
  589. var
  590.  s: string;
  591.  num,oldnum: integer;
  592.  a: integer;
  593. begin;
  594.  num:=0;
  595.  repeat;
  596.   seek(bbsfile,num);
  597.   read(bbsfile,bbs);
  598.   oldnum:=num;
  599.   repeat;
  600.    sclrscr;
  601.    display_rec;
  602.    swriteln('');
  603.    swrite('Enter letter to change, <N>ext, <P>rev, <Q>uit ? ');
  604.    sread(s);
  605.    s:=stu(s);
  606.    if s='A' then begin;
  607.     swrite('System name: '); prompt(bbs.board_name,20,true);
  608.    end;
  609.    if s='B' then begin;
  610.     swrite('Number: '); prompt(bbs.number,8,true);
  611.    end;
  612.    if s='C' then begin;
  613.     swrite('Hours: '); prompt(bbs.hours,9,true);
  614.    end;
  615.    if s='D' then begin;
  616.     swrite('Maximum baud: '); prompt(s,4,true);
  617.     val(s,bbs.max_baud,a);
  618.    end;
  619.    if s='E' then begin;
  620.     swrite('300 allowed (Y/N): '); prompt(s,1,true);
  621.     if (s='Y') or (s='y') then bbs.allow3:=true else bbs.allow3:=false;
  622.    end;
  623.    if s='F' then begin;
  624.     swrite('Megs storage: '); prompt(s,4,true);
  625.     val(s,bbs.megs,a);
  626.    end;
  627.    if s='G' then begin;
  628.     swrite('Network address: '); prompt(bbs.network,10,true);
  629.    end;
  630.    if s='H' then begin;
  631.     swrite('Sysop name: '); prompt(bbs.sysop_name,20,true);
  632.    end;
  633.    if s='I' then begin;
  634.     swrite('Software: '); prompt(bbs.software,10,true);
  635.    end;
  636.    if s='J' then begin;
  637.     swrite('Pay required (Y/N)? '); prompt(s,1,true);
  638.     if (s='Y') or (s='y') then bbs.pay:=true else bbs.pay:=false;
  639.    end;
  640.    if s='K' then edit_systems;
  641.    if s='N' then if num<filesize(bbsfile)-1 then num:=num+1;
  642.    if s='P' then if num>0 then num:=num-1;
  643.   until s[1] in ['N','P','Q'];
  644.   seek(bbsfile,oldnum);
  645.   write(bbsfile,bbs);
  646.  until s='Q';
  647. end;
  648.  
  649. procedure DoMore;
  650. var
  651.  ch: char;
  652. begin;
  653.  swrite('<More>');
  654.  sread_char(ch);
  655. end;
  656.  
  657. function Lower(rec1,rec2: bbsentry): boolean;
  658. begin;
  659.  case sortmode of
  660.   1: if rec1.board_name<rec2.board_name then lower:=true else lower:=false;
  661.   2: if rec1.max_baud<rec2.max_baud then lower:=true else lower:=false;
  662.   3: if rec1.megs<rec2.megs then lower:=true else lower:=false;
  663.  end;
  664. end;
  665.  
  666. procedure SortList;
  667. type
  668.  sorttype= array[1..75] of bbsentry;
  669.  sortptr= ^sorttype;
  670. var
  671.  i1,i2: sortptr;
  672.  numrecs: word;
  673.  a,nm2,lownum: byte;
  674. begin;
  675.  new(i1);
  676.  new(i2);
  677.  sclrscr;
  678.  swrite('Sort mode: 1=Name, 2=Baud, 3=Megs ? ');
  679.  sread_num(sortmode);
  680.  numrecs:=0;
  681.  reset(bbsfile);
  682.  while not eof(bbsfile) do begin;
  683.   inc(numrecs);
  684.   read(bbsfile,i1^[numrecs]);
  685.  end;
  686.  nm2:=0;
  687.  repeat;
  688.   lownum:=0;
  689.   for a:=1 to numrecs do if i1^[a].active then begin;
  690.    if lownum=0 then lownum:=a else if lower(i1^[a],i1^[lownum]) then lownum:=a;
  691.   end;
  692.   if lownum<>0 then begin;
  693.    inc(nm2);
  694.    i2^[nm2]:=i1^[lownum];
  695.    i1^[lownum].active:=false;
  696.   end;
  697.  until lownum=0;
  698.  rewrite(bbsfile);
  699.  for a:=1 to nm2 do write(bbsfile,i2^[a]);
  700.  reset(bbsfile);
  701.  dispose(i1);
  702.  dispose(i2);
  703. end;
  704.  
  705. procedure bbslist_menu;
  706. var
  707.  n: integer;
  708.  ch: char;
  709. begin;
  710.  repeat;
  711.   ch:=getansimenu(menu1);
  712.   if ch in ['C','D','E','F','I'] then sclrscr;
  713.   case ch of
  714.    'A': add_system;
  715.    'B': edit_bbslist;
  716.    'C': Display_80_asc;
  717.    'D': Display_80_txt;
  718.    'E': Display_132_asc;
  719.    'F': display_132_txt;
  720.    'G': write_to_disk;
  721.    'H': SortList;
  722.    'I': DisplayStats;
  723.   end;
  724.   if ch in ['C','D','E','F','I'] then DoMore;
  725.  until ch='Q';
  726. end;
  727.  
  728. begin;
  729.  checkbreak:=true;
  730.  initdoordriver('doordriv.ctl');
  731.  todisk:=false;
  732.  filemode:=66;
  733.  assign(bbsfile,'bbslist.dat');
  734.  if not exist('bbslist.dat') then rewrite(bbsfile) else reset(bbsfile);
  735.  bbslist_menu;
  736.  close(bbsfile);
  737. end.